home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / SATAN11.ZIP / PERL / FIX_HOST.PL < prev    next >
Text File  |  1995-04-11  |  2KB  |  75 lines
  1. # fix possibly unqualified or truncated hostname, given the fqdn of the
  2. # host that we got the information from.
  3. #
  4.  
  5. sub fix_hostname {
  6.     local ($host, $origin) = @_;
  7.     local ($fqdn, $dot, $old, $frag, $n, $trial);
  8.  
  9.     # First see if the name (or IP address) is in the DNS.
  10.     if ($host =~ /\./ && ($frag = &get_host_name(&get_host_addr($host)))) {
  11.     $host = $frag;
  12.     }
  13.  
  14.     # Can't do anything else for IP addresses.
  15.     if ($host =~ /^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/) {
  16.     return "";
  17.     }
  18.  
  19.     # Can't do hostname completion when the originator is an IP address.
  20.     if ($origin =~ /^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/) {
  21.     return $host;
  22.     }
  23.  
  24.     # Assume an unqualified name is in the same domain as the originator.
  25.     # 
  26.     if (($dot = index($host, ".")) < $[) {
  27.     return &get_host_name($host . substr($origin, index($origin, ".")));
  28.     }
  29.     $old = $dot;
  30.  
  31.     # Assume the hostname is trucated.
  32.     foreach $trial ($origin, ".mil", ".edu", ".gov", ".net", ".org", ".com") {
  33.         for ($dot = $old; length($frag = substr($host,$dot-$[)) > 1; $dot += $n) {
  34.             # Match .fragment with (upper domain) of trial domain.
  35.             if (($n = index($trial, $frag)) >= $[) {
  36.                 if ($fqdn = &get_host_name(substr($host, $[, $dot - $[) . substr($trial, $n))) {
  37.             return $fqdn;
  38.         }
  39.         }
  40.             # Strip lowest .subdomain from .fragment and retry.
  41.             last if (($n = index(substr($frag, $[ + 1), ".") + 1 - $[) < 1);
  42.         }
  43.     }
  44.  
  45.     # Unable to fix the hostname.
  46.     #
  47.     return "";
  48. }
  49.  
  50. #
  51. # Some scaffolding for stand-alone testing.
  52. #
  53. if ($running_under_satan) {
  54.     require 'perl/get_host.pl';
  55. } else {
  56.     $running_under_satan = -1;
  57.  
  58.     require 'perllib/getopts.pl';
  59.     require 'perl/get_host.pl';
  60.  
  61.     warn "fix_hostname.pl running in test mode";
  62.  
  63.     $usage = "usage: fix_hostname partial_name complete_name\n";
  64.     &Getopts("v");
  65.  
  66.     if ($#ARGV != 1) {
  67.     print STDERR $usage;
  68.     exit 1;
  69.     }
  70.  
  71.     print &fix_hostname($ARGV[0], $ARGV[1]),"\n";
  72. }
  73.  
  74. 1;
  75.